home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Kick Pascal v2.10 d2.adf / DEMO / Graphdemo.p < prev    next >
Text File  |  1990-11-01  |  5KB  |  135 lines
  1. Program Grafikdemo;
  2.  
  3. Uses Intuition, Graphics;
  4.  
  5. Const Breite=640; Hoehe=256; MEMF_CHIP=2;
  6.  
  7. Type IntArr10=Array[1..10] of Integer;
  8.      LongArr16=Array[1..16] of Long;
  9.  
  10. Var NeuWindow:NewWindow;
  11.     MyWindow:^Window;
  12.     Menu1,Menu2:Menu;
  13.     Mi1_1,Mi1_2:MenuItem;
  14.     MiT1_1,MiT1_2,Knopftx,Textdummy: IntuiText;
  15.     Knopf,Schieber,Textgad: Gadget;
  16.     KnopfBord,TextBord: Border;
  17.     SchieberInfo: PropInfo;
  18.     TextInfo: StringInfo;
  19.     BorderXY,TextBordXY:IntArr10;
  20.     Imageplane: ^LongArr16;
  21.     Bild: Image;
  22.     Buffer,UndoBuffer: string[80];
  23.     MoverData: Array[1..6]of integer;
  24.     Rast:^RastPort;
  25.     L:Long;
  26.     i,x2,y2:Integer;
  27.     MyScreen: ^Screen;
  28.     Msg,Upt: ptr;
  29.  
  30. Begin
  31.   Imageplane:=ptr(Alloc_mem(SizeOf(LongArr16),MEMF_CHIP));
  32.   Bild:=Image(0,0,32,16,1,imageplane,1,0,Nil);
  33.   Imageplane^:=LongArr16(
  34.     %00011111111111111111111111111000,
  35.     %01110000000000000000000000001110,
  36.     %11100011110011110001111111000111,
  37.     %11000001100001100011100000000011,
  38.     %11000001111111100001111110000011,
  39.     %11000001100001100000000111000011,
  40.     %11000011110011110011111110000011,
  41.     %11000000000000000000000000000011,
  42.     %11000000000000000000000000000011,
  43.     %11000001111111000011111110000011,
  44.     %11000011100000000111000111000011,
  45.     %11000001111110000110000000000011,
  46.     %11000000000111000111000111000011,
  47.     %11100011111110000011111110000111,
  48.     %01110000000000000000000000001110,
  49.     %00011111111111111111111111111000);
  50.   MyScreen:=Open_Screen(0,0,Breite,Hoehe,2,0,1,HIRES or GENLOCK_VIDEO,'Himpelpascal Demo');
  51.   SetRGB4(^MyScreen^.ViewPort,1,15,15,15);
  52.   SetRGB4(^MyScreen^.ViewPort,2,0,0,15);
  53.   SetRGB4(^MyScreen^.ViewPort,3,15,15,15);
  54.   Menu1:=Menu(^Menu2,10,0,80,10,MENUENABLED,'Menü 1',^Mi1_1,0,0,0,0);
  55.   Mi1_1:=MenuItem(^Mi1_2,0,0,80,10,ITEMTEXT or ITEMENABLED or HIGHCOMP,0,
  56.                   ^MiT1_1,Nil,chr(0),Nil,0);
  57.   MiT1_1:=IntuiText(0,1,0,5,3,Nil,'Punkt 1',Nil);
  58.   Mi1_2:=MenuItem(Nil,0,12,80,12,ITEMTEXT or ITEMENABLED or HIGHCOMP or COMMSEQ,
  59.                   0,^MiT1_2,Nil,'2',Nil,0);
  60.   MiT1_2:=IntuiText(0,1,0,5,3,Nil,'Punkt 2',Nil);
  61.   Menu2:=Menu(Nil,100,0,80,10,MENUENABLED,'Menü 2',Nil,0,0,0,0);
  62.   Knopf:=Gadget(Nil,-121,-23,100,20,GADGHCOMP or GRELBOTTOM or GRELRIGHT,
  63.                 RELVERIFY or TOGGLESELECT,BOOLGADGET,^KnopfBord,Nil,
  64.                 ^Knopftx,0,Nil,1,0);
  65.   Knopftx:=Intuitext(1,0,0,(100-11*8)div 2,6,Nil,'Klick here!',Nil);
  66.   KnopfBord:=Border(0,0,1,0,1,5,^BorderXY,Nil);
  67.   BorderXY:=IntArr10(-3,-2,102,-2,102,21,-3,21,-3,-2);
  68.   Schieber:=Gadget(Nil,-16,12,16,-18,GADGHCOMP or GRELHEIGHT or GRELRIGHT,
  69.                    RELVERIFY or GADGIMMEDIATE,PROPGADGET,^Moverdata,Nil,
  70.                    Nil,0,^Schieberinfo,2,0);
  71.   SchieberInfo:=Propinfo(FREEVERT or AUTOKNOB,$8000,$8000,0,$8000 div 5,
  72.                          0,0,0,0,0,0);
  73.   TextGad:=Gadget(Nil,8,64,120,8,GADGHCOMP,GADGIMMEDIATE,STRGADGET,^TextBord,
  74.                   Nil,Nil,0,^TextInfo,3,0);
  75.   TextInfo:=StringInfo(^Buffer,^Undobuffer,0,76,0,0,0,0,0,0,Nil,0,Nil);
  76.   TextBord:=Border(0,0,1,0,1,5,^TextbordXY,Nil);
  77.   TextBordXY:=IntArr10(-3,-3,123,-3,123,10,-3,10,-3,-3);
  78.   Buffer:='Hallo'; UndoBuffer:='';
  79.   NeuWindow:=NewWindow(125,50,400,120,0,1,GADGETUP or GADGETDOWN,
  80.            ACTIVATE or WINDOWSIZING or WINDOWDRAG or WINDOWDEPTH or WINDOWCLOSE,
  81.            Nil,Nil,'Intuitiondemo',MyScreen,Nil,100,80,Breite,Hoehe,CUSTOMSCREEN);
  82.   MyWindow:=OpenWindow(^Neuwindow);
  83.   If MyWindow=Nil Then Error('Fenster kann nicht geöffnet werden!');
  84.   Rast:=MyWindow^.RPort;
  85.   Upt:=MyWindow^.Userport;
  86.   TextDummy:=Intuitext(1,0,0,0,0,Nil,'© by      the Himpel Software Systems Company.',Nil);
  87.   PrintIText(Rast,^TextDummy,10,16);
  88.   SetMenuStrip(MyWindow,^Menu1);
  89.   AddGadget(MyWindow,^Knopf,Nil);
  90.   AddGadget(MyWindow,^Schieber,^Knopf);
  91.   AddGadget(MyWindow,^TextGad,^Knopf);
  92.   RefreshGadgets(^Knopf,MyWindow,Nil);
  93.   DrawImage(Rast,^Bild,50,12);
  94.   While Knopf.flags and SELECTED=0 do
  95.     Begin
  96.       Msg:=Wait_Port(Upt);
  97.       If Msg<>Nil Then
  98.         Begin
  99.           Msg:=Get_Msg(Upt);
  100.           Reply_Msg(Msg)
  101.         End
  102.     End;
  103.   RemoveGadgets(MyWindow,^Knopf);
  104.   RemoveGadgets(MyWindow,^Schieber);
  105.   RemoveGadgets(MyWindow,^TextGad);
  106.   ClearMenuStrip(MyWindow);
  107.   For l:=12 to MyWindow^.Height do
  108.     ScrollRaster(Rast,(32-l) div 10,-1,2,12,MyWindow^.Width-4,MyWindow^.Height-2);
  109.   Rast:=^MyScreen^.Rastport;
  110.   x2:=1+MyWindow^.LeftEdge+MyWindow^.Width;
  111.   y2:=1+MyWindow^.TopEdge+MyWindow^.Height;
  112.   For i:=12 to MyWindow^.LeftEdge Do
  113.     ScrollRaster(Rast,1,1+i div 20,0,12,x2,y2);
  114.   CloseWindow(MyWindow);
  115.   For L:=80 to 800 do
  116.     Begin
  117.       SetAPen(Rast,1+(L mod 3));
  118.       Move(Rast,Round(320-315*sin(L/50)),Round(130+115*cos(L/80)));
  119.       Draw(Rast,Round(320+315*cos(L/100)),Round(130-115*sin(L/120)));
  120.     End;
  121.   Delay(4*50);
  122.   For L:=1 to Breite div 12 Do
  123.     ScrollRaster(Rast,12,0,0,12,Breite,Hoehe);
  124.   ClearScreen(Rast);
  125.   For i:=1 to Hoehe Do
  126.     Begin
  127.       MoveScreen(MyScreen,0,1);
  128.       For L:=1 to 200 do
  129.     End;
  130.   Close_Screen(MyScreen);
  131.   Free_Mem(long(Imageplane),SizeOf(LongArr16));
  132.   writeln; writeln('Text: ',Buffer)
  133. End.
  134.  
  135.